-- card: 12558 from stack: in.3 -- bmap block id: 0 -- flags: 4000 -- background id: 3241 -- name: IsResource ----- HyperTalk script ----- on Install get ChooseTargetStack() InstallResource XFCN,IsResource,it end Install -- part 1 (button) -- low flags: 00 -- high flags: A003 -- rect: left=66 top=300 right=322 bottom=209 -- title width / last selected line: 0 -- icon id / first selected line: 0 / 0 -- text alignment: 1 -- font id: 0 -- text size: 12 -- style flags: 0 -- line height: 16 -- part name: Check for an XCMD ----- HyperTalk script ----- on mouseUp global resInfo put "XCMD" into resType ask "Which" && resType && "do you want to check for?" put it into resName get IsResource(resType, resName) if it is true then answer item 1 of resInfo && item 3 of resInfo & "," && item 2 of resInfo & "," && item 4 of resInfo && "bytes." with "OK" else answer resType && resName && "not found." with "OK" end mouseUp -- part 2 (field) -- low flags: 81 -- high flags: 2007 -- rect: left=12 top=26 right=298 bottom=491 -- title width / last selected line: 0 -- icon id / first selected line: 0 / 0 -- text alignment: 0 -- font id: 22 -- text size: 10 -- style flags: 0 -- line height: 13 -- part name: Source -- part 3 (button) -- low flags: 00 -- high flags: A003 -- rect: left=299 top=300 right=322 bottom=438 -- title width / last selected line: 0 -- icon id / first selected line: 0 / 0 -- text alignment: 1 -- font id: 0 -- text size: 12 -- style flags: 0 -- line height: 16 -- part name: Show Pascal Source ----- HyperTalk script ----- on mouseUp set the visible of card field 1 to not the visible of card field 1 if the visible of card field 1 is true then set the name of me to "Hide Pascal Source" else set the name of me to "Show Pascal Source" end mouseUp -- part contents for background part 16 ----- text ----- ISRESOURCE XFCN version 1.0.2 Kevin Calhoun IsResource checks for the availability of a resource by its resource type and name, by its resource type and ID, or by its resource type, name, and ID. You can check for the presence of a resource in any currently open resource file or in just the most recently opened resource file. If IsResource returns TRUE, additional information about the resource will be available in the global variable "resInfo." (This requires HyperCard 1.2 or later.) Item 1 of resInfo will be the resource type, item 2 the resource name, item 3 the resource ID, item 4 the size of the resource in bytes, and item 5 the name of the resource file in which the resource was found. INVOKING ISRESOURCE get IsResource("resType",<"resName">,,) result: true or false If the fourth parameter, which is optional, is TRUE, IsResource checks only the most recently opened resource file. Note that the most recently opened resource file is not necessarily that of the current stack (the current stack might not have a resource fork). If you want to be certain that an existing resource is contained in a particular stack, use the following function: function ResInStack resType,resName,resID,stackName global resInfo lock screen push card go to stack stackName put the long name of this stack into stackPathname delete word 1 of stackPathname delete char 1 of stackPathname delete last char of stackPathName put IsResource(resType,resName,resID,TRUE) into resExists pop card unlock screen if resExists is FALSE then return FALSE else return (item 5 of resInfo is stackPathname) end ResInStack EXAMPLES IsResource("XCMD", "PrintField") would return true if an XCMD named PrintField were available in any one of the currently open resource files. IsResource("XCMD", "PrintField", 9140) would return true if an XCMD named PrintField and numbered 9140 were available in any currently open resource file. IsResource("XCMD",empty, 9140) would return true if any XCMD numbered 9140 were currently available. REVISION HISTORY 15 March 1989 1.0 30 April 1989 1.0.1 -- Item 5 of global resInfo is now full pathname of file containing resource. Also, IsResource no longer leaves an orphaned handle in heap. 11 June 1989 1.0.2 -- Fixed problem of not getting full pathname of system file when resource lives there. Inside Macintosh lies. Volume 1, page 116: "When calling...HomeResFile..., be aware that for the system resource file the actual reference number is returned." Not true. Zero is returned. Also, fixed problem of not returning the resource type correctly when a resource type of more than 4 characters is supplied. (IsResource ignores the extra characters.) -- part contents for card part 2 ----- text ----- UNIT IsResourceUnit; { IsResource XFCN © 1989 by the Trustees of Dartmouth College } { Written by Kevin Calhoun } { This source compatible with MPW Pascal 3.0 } (* Pascal IsResource.p Link -m ENTRYPOINT ∂ -o "{boot}Hyper ƒ:HyperCard Stacks:Dartmouth XCMD's 3.1" ∂ -rt XFCN=7508 ∂ -sn Main=IsResource ∂ IsResource.p.o ∂ "{Libraries}"interface.o ∂ "{PLibraries}"Paslib.o ∂ "{Libraries}"HyperXLib.o *) {$S IsResource } {$R-} interface USES Types, Memory, Resources, Files, Errors, ToolUtils, OSUtils, HyperXCmd; PROCEDURE EntryPoint (paramPtr : XCMDPtr); IMPLEMENTATION {-----------------------------------------------------------------} PROCEDURE IsResource (paramPtr: XCMDPtr); FORWARD; PROCEDURE EntryPoint (paramPtr : XCMDPtr); BEGIN IsResource(paramPtr); END; FUNCTION SysRefNum: INTEGER; CONST SysMap=$A58; { reference number of sysResFile [word] I-114 } TYPE WordPtr = ^INTEGER; VAR w: WordPtr; BEGIN w := WordPtr(SysMap); SysRefNum := w^; END; PROCEDURE DirIDToPath(dirID: INTEGER; vRefNum: INTEGER; VAR path: Str255); LABEL 99; VAR result: INTEGER; str: Str255; pbHandle: Handle; pb: CInfoPBPtr; BEGIN path := ''; pbHandle := NewHandleClear(SIZEOF(CInfoPBRec)); IF MemError <> noErr THEN GOTO 99; HLock(pbHandle); pb := CInfoPBPtr(pbHandle^); pb^.ioDirID := dirID; WHILE pb^.ioDirID <> 1 DO BEGIN pb^.ioNamePtr := @str; pb^.ioFDirIndex := -1; pb^.ioVRefNum := vRefNum; IF PBGetCatInfo(pb,FALSE) <> noErr THEN Exit(DirIDToPath); path := Concat(str,':',path); pb^.ioDirID := pb^.ioDrParID; END; 99: IF pbHandle <> NIL THEN DisposHandle(pbHandle); END; PROCEDURE FRefNumToPathname(fRefNum: INTEGER; VAR path: Str255); LABEL 99; VAR err: OSErr; myFCBPBHndl: Handle; myFCBPBPtr: FCBPBPtr; fName: Str255; BEGIN err := noErr; path := ''; myFCBPBHndl := NewHandleClear(SIZEOF(FCBPBRec)); IF MemError <> noErr THEN GOTO 99; HLock(myFCBPBHndl); myFCBPBPtr := FCBPBPtr(myFCBPBHndl^); WITH myFCBPBPtr^ DO BEGIN ioNamePtr := @fName; ioRefNum := fRefNum; END; err := PBGetFCBInfo(myFCBPBPtr, FALSE); IF err=noErr THEN BEGIN DirIDToPath(myFCBPBPtr^.ioFCBParID, myFCBPBPtr^.ioFCBVRefNum,path); path := CONCAT(path,fName); END; 99: IF myFCBPBHndl <> NIL THEN DisposHandle(myFCBPBHndl); END; FUNCTION MyGetResource(rType: ResType; id: INTEGER; oneFile: BOOLEAN): Handle; BEGIN IF oneFile THEN MyGetResource := Get1Resource(rType, id) ELSE MyGetResource := GetResource(rType, id); END; FUNCTION MyGetNamedResource(rType: ResType; name: Str255; oneFile: BOOLEAN): Handle; BEGIN IF oneFile THEN MyGetNamedResource := Get1NamedResource(rType, name) ELSE MyGetNamedResource := GetNamedResource(rType, name); END; PROCEDURE IsResource (paramPtr: XCMDPtr); VAR paramCount: INTEGER; str,resName: Str255; resourceType, resID, resSize: String[5]; theID, anID: INTEGER; theType: ResType; r1, r2, h: Handle; size: LONGINT; gotName, gotID, topMapOnly, present: BOOLEAN; nullPos: INTEGER; zero: String[1]; fileRefNum: INTEGER; err: OSErr; PROCEDURE passReturnValue (errMsg : Str255); { set theResult } BEGIN paramPtr^.returnValue := PasToZero(paramPtr, errMsg); END; BEGIN paramCount := paramPtr^.paramCount; r1 := NIL; r2 := NIL; err := resNotFound; IF paramCount > 1 THEN BEGIN zero := ' '; zero[1] := CHR(0); ZeroToPas(paramPtr, paramPtr^.params[1]^,str); BlockMove(POINTER(ORD4(@str)+1), @theType, 4); ZeroToPas(paramPtr, paramPtr^.params[2]^, resName); gotName := LENGTH(resName) > 0; gotID := FALSE; IF paramCount > 2 THEN BEGIN ZeroToPas(paramPtr, paramPtr^.params[3]^, str); IF LENGTH(str) > 0 THEN BEGIN gotID := TRUE; theID := LoWord(StrToNum(paramPtr, str)); END; END; topMapOnly := FALSE; IF paramCount > 3 THEN BEGIN ZeroToPas(paramPtr,paramPtr^.params[4]^,str); topMapOnly := StrToBool(paramPtr,str); END; SetResLoad(FALSE); IF gotName THEN BEGIN r1 := MyGetNamedResource(theType, resName, topMapOnly); GetResInfo(r1, anID, theType, resName); err := ResError; IF (err = noErr) AND gotID THEN BEGIN r2 := MyGetResource(theType, theID, topMapOnly); GetResInfo(r2, theID, theType, str); err := ResError; if err = noErr then if (anID <> theID) or NOT EqualString(resName,str,FALSE,TRUE) then err := resNotFound; END; theID := anID; END ELSE IF gotID THEN BEGIN r1 := MyGetResource(theType, theID, topMapOnly); GetResInfo(r1, theID, theType, resName); err := ResError; END; SetResLoad(TRUE); present := err = noErr; BoolToStr(paramPtr, present, str); PassReturnValue(str); IF present THEN BEGIN resourceType[0] := CHR(4); BlockMove(@theType,Ptr(ORD4(@resourceType)+1),4); NumToStr(paramPtr, theID, str); resID := str; size := SizeResource(r1); NumToStr(paramPtr, size, str); resSize := str; { remove nulls from resource name } nullPos := POS(zero, resName); WHILE nullPos > 0 DO BEGIN DELETE(resName, nullPos, 1); nullPos := POS(zero, resName); END; fileRefNum := HomeResFile(r1); IF fileRefNum = 0 THEN fileRefNum := SysRefNum; FRefNumToPathname(fileRefNum,str); str := CONCAT(resourceType,',',resName,',',resID, ',',resSize,',',str); h := PasToZero(paramPtr, str); SetGlobal(paramPtr, 'resInfo', h); DisposHandle(h); END; END ELSE PassReturnValue('IsResource XFCN 1.0.2, 11 June 1989, ©1989 Dartmouth College'); END; END.